home *** CD-ROM | disk | FTP | other *** search
/ Games of Daze / Infomagic - Games of Daze (Summer 1995) (Disc 1 of 2).iso / x2ftp / msdos / iguana / incosrc / incosrc.exe / MIRRBALL / PATH / SPLIN.PAS < prev   
Pascal/Delphi Source File  |  1994-06-09  |  11KB  |  508 lines
  1.  
  2. USES Crt, Objects, Matrix;
  3.  
  4. FUNCTION POW2(a : DOUBLE): DOUBLE;
  5.   BEGIN
  6.      POW2 := a*a
  7.   END;
  8.  
  9. FUNCTION POW3(a : DOUBLE): DOUBLE;
  10.   BEGIN
  11.      POW3 := a*a*a
  12.   END;
  13.  
  14. FUNCTION TAN(a : DOUBLE): DOUBLE;
  15.   BEGIN
  16.      TAN := Sin(a)/Cos(a)
  17.   END;
  18.  
  19.   { --------------------------------- }
  20.  
  21.  
  22. TYPE
  23.    Pt = RECORD
  24.       f, t, slope : DOUBLE;
  25.       a, b, c, d  : DOUBLE
  26.    END;
  27.  
  28.    PtArray = RECORD
  29.       npts : INTEGER;
  30.       pts  : ARRAY [1..200] OF Pt;
  31.    END;
  32.  
  33.  
  34. PROCEDURE CalcSlopes(VAR pa: PtArray);
  35.   VAR
  36.      i : INTEGER;
  37.   BEGIN
  38.      FOR i := 1 TO pa.npts DO BEGIN
  39.         IF i = 1 THEN
  40.            pa.pts[i].slope := (pa.pts[i+1].f-pa.pts[i].f) /
  41.                           (pa.pts[i+1].t-pa.pts[i].t)
  42.         ELSE IF i = pa.npts THEN
  43.            pa.pts[i].slope := (pa.pts[i].f-pa.pts[i-1].f) /
  44.                           (pa.pts[i].t-pa.pts[i-1].t)
  45.         ELSE
  46.             pa.pts[i].slope := TAN(
  47.                  (ARCTAN((pa.pts[i+1].f-pa.pts[i].f) /
  48.                          (pa.pts[i+1].t-pa.pts[i].t)) +
  49.                   ARCTAN((pa.pts[i].f-pa.pts[i-1].f) /
  50.                          (pa.pts[i].t-pa.pts[i-1].t)))/2);
  51.  
  52.  
  53.         {WriteLn('Pendiente calculada: ', pa.pts[i].slope);}
  54.      END
  55.   END;
  56.  
  57.  
  58. PROCEDURE CalcCoeffs(VAR pa: PtArray);
  59.   VAR
  60.      i      : INTEGER;
  61.      ma, m1 : Matrix4x4;
  62.      da, d1 : DOUBLE;
  63.      b      : Column4;
  64.   BEGIN
  65.      CalcSlopes(pa);
  66.      ma[4,1] := 1;
  67.      ma[4,2] := 1;
  68.      ma[3,3] := 1;
  69.      ma[3,4] := 1;
  70.      ma[4,3] := 0;
  71.      ma[4,4] := 0;
  72.      FOR i := 1 TO pa.npts-1 DO BEGIN
  73.         b[1] := pa.pts[i].f;
  74.         b[2] := pa.pts[i+1].f;
  75.         b[3] := pa.pts[i].slope;
  76.         b[4] := pa.pts[i+1].slope;
  77.         ma[3,1] := pa.pts[i].t;
  78.         ma[3,2] := pa.pts[i+1].t;
  79.         ma[2,3] := pa.pts[i].t*2;
  80.         ma[2,4] := pa.pts[i+1].t*2;
  81.         ma[2,1] := POW2(pa.pts[i].t);
  82.         ma[2,2] := POW2(pa.pts[i+1].t);
  83.         ma[1,3] := POW2(pa.pts[i].t)*3;
  84.         ma[1,4] := POW2(pa.pts[i+1].t)*3;
  85.         ma[1,1] := POW3(pa.pts[i].t);
  86.         ma[1,2] := POW3(pa.pts[i+1].t);
  87.         da := Determinante4(ma);
  88.  
  89.         PrepareMatrix(m1, ma, b, 1);
  90.         d1 := Determinante4(m1);
  91.         pa.pts[i].a := d1/da;
  92.  
  93.         PrepareMatrix(m1, ma, b, 2);
  94.         d1 := Determinante4(m1);
  95.         pa.pts[i].b := d1/da;
  96.  
  97.         PrepareMatrix(m1, ma, b, 3);
  98.         d1 := Determinante4(m1);
  99.         pa.pts[i].c := d1/da;
  100.  
  101.         PrepareMatrix(m1, ma, b, 4);
  102.         d1 := Determinante4(m1);
  103.         pa.pts[i].d := d1/da;
  104. {        WriteLn('Calculados coeficientes del segmento ',i, ',')}
  105.      END;
  106.   END;
  107.  
  108.  
  109.  
  110.  
  111.   { ----------------------------------- }
  112.  
  113. FUNCTION Interpolate(VAR pf: PtArray; x : DOUBLE): DOUBLE;
  114.   VAR
  115.      i : INTEGER;
  116.  
  117.   BEGIN
  118.      Interpolate := 0;
  119.      FOR i := 2 TO pf.npts-2 DO
  120.         IF (x >= pf.pts[i].t) AND (x <= pf.pts[i+1].t) THEN
  121.            Interpolate := pf.pts[i].a*POW3(x) +
  122.                           pf.pts[i].b*POW2(x) +
  123.                           pf.pts[i].c*     x  +
  124.                           pf.pts[i].d
  125.  
  126.   END;
  127.  
  128.   { ----------------------------------- }
  129.  
  130. VAR
  131.    PF1, PF2, PF3 : PtArray;
  132.  
  133. PROCEDURE ReadPtList(FName: STRING);
  134.   VAR
  135.      fi        : TEXT;
  136.      i         : INTEGER;
  137.      t, f1,
  138.      f2, f3    : DOUBLE;
  139.   BEGIN
  140.      Assign(fi, FName);
  141.      Reset(fi);
  142.  
  143.      i := 1;
  144.      WHILE (i <= 200) AND NOT Eof(fi) DO BEGIN
  145.         t := -1;
  146.         ReadLn(fi, t, f1, f2, f3);
  147.         IF t < 0 THEN BEGIN
  148.            PF1.npts := i-1;
  149.            PF2.npts := i-1;
  150.            PF3.npts := i-1;
  151.            Close(fi);
  152.            EXIT
  153.         END;
  154.         PF1.pts[i].t := t;
  155.         PF2.pts[i].t := t;
  156.         PF3.pts[i].t := t;
  157.         PF1.pts[i].f := f1;
  158.         PF2.pts[i].f := f2;
  159.         PF3.pts[i].f := f3;
  160. {        WriteLn('Leido...');}
  161.         INC(i)
  162.      END;
  163.      PF1.npts := i-1;
  164.      PF2.npts := i-1;
  165.      PF3.npts := i-1;
  166.  
  167.      Close(fi);
  168.   END;
  169.  
  170. PROCEDURE WritePtList(FName: STRING);
  171.   VAR
  172.      fi        : TEXT;
  173.      i         : INTEGER;
  174.      t, f1, f2 : DOUBLE;
  175.   BEGIN
  176.      Assign(fi, FName);
  177.      Rewrite(fi);
  178.  
  179.      FOR i := 1 TO PF1.npts DO BEGIN
  180.         WriteLn(fi, PF1.pts[i].t : 10 : 1, PF1.pts[i].f : 10 : 1, PF2.pts[i].f : 10 : 1, PF3.pts[i].f : 10 : 1);
  181.      END;
  182.  
  183.      Close(fi);
  184.   END;
  185.  
  186. { ----------------------------------- }
  187.  
  188. TYPE
  189.    TScr = ARRAY[0..199,0..319] OF BYTE;
  190.  
  191. VAR
  192.    Screen : TScr ABSOLUTE $A000:0;
  193.  
  194.  
  195. PROCEDURE Usage;
  196.   BEGIN
  197.      WriteLn('Cubic Spline Generator v0.5, (C) 1993 bye Jare/Iguana');
  198.      WriteLn('   Usage: PATH nsteps [infile]');
  199.      HALT
  200.   END;
  201.  
  202. VAR
  203.   i  : INTEGER;
  204.   fi : TEXT;
  205.   t, x, y, z : DOUBLE;
  206.  
  207.   NFrames : INTEGER;
  208.  
  209.   Pant : ^TScr;
  210.  
  211. CONST
  212.   MI : Matrix4x4 = ((1.0, 2.0, 3.0, 4.0),
  213.                     (5.0, 9.0, 8.0, 7.0),
  214.                     (3.0, 2.0, 1.0, 9.0),
  215.                     (4.0, 2.0, 6.0, 7.0));
  216.  
  217.  
  218. PROCEDURE DumpPal;
  219.   BEGIN
  220.     Port[$3C8] := 64;
  221.     FOR i := 16 TO 63 DO
  222.       BEGIN
  223.         Port[$3C9] := i;
  224.         Port[$3C9] := i;
  225.         Port[$3C9] := i;
  226.       END;
  227.   END;
  228.  
  229. PROCEDURE Pinta;
  230.    BEGIN
  231.       IF PF1.npts >= 3 THEN
  232.         BEGIN
  233.           CalcCoeffs(PF1);
  234.           CalcCoeffs(PF2);
  235.           CalcCoeffs(PF3);
  236.  
  237.           Screen := Pant^;
  238.  
  239.           FOR i := 0 TO NFrames-1 DO BEGIN
  240.              t := i*(PF1.pts[PF1.npts-1].t - PF1.pts[2].t)/NFrames +
  241.                   PF1.pts[2].t;
  242.              x := Interpolate(PF1,t);
  243.              y := Interpolate(PF2,t);
  244.              z := Interpolate(PF3,t);
  245.  
  246.              IF z >  11.0 THEN z :=  11.0;
  247.              IF z < -36.0 THEN z := -36.0;
  248.  
  249.              Screen[ROUND(y), ROUND(x)] := ROUND(z)+36+64;
  250.           END;
  251.         END;
  252.  
  253.       FOR i := 1 TO PF1.npts DO BEGIN
  254.          t := PF1.pts[i].t;
  255.          x := PF1.pts[i].f;
  256.          y := PF2.pts[i].f;
  257.          Screen[ROUND(y),   ROUND(x)  ] := 10;
  258.          Screen[ROUND(y)+1, ROUND(x)  ] := 10;
  259.          Screen[ROUND(y),   ROUND(x)+1] := 10;
  260.          Screen[ROUND(y)-1, ROUND(x)  ] := 10;
  261.          Screen[ROUND(y),   ROUND(x)-1] := 10;
  262.       END;
  263.  
  264.    END;
  265.  
  266.  
  267. PROCEDURE Salva;
  268.    VAR
  269.      ot, ox, oy, oz : INTEGER;
  270.      f : FILE OF BYTE;
  271.      b : BYTE;
  272.    BEGIN
  273.       IF PF1.npts >= 3 THEN
  274.         BEGIN
  275.  
  276.           Assign(f, 'POINTS.DAT');
  277.           Rewrite(f);
  278.  
  279.           b := LO(NFrames);
  280.           Write(f, b);
  281.           b := HI(NFrames);
  282.           Write(f, b);
  283.  
  284.           t  := PF1.pts[2].t;
  285.           ox := ROUND(Interpolate(PF1,t));
  286.           oy := ROUND(Interpolate(PF2,t));
  287.           oz := ROUND(Interpolate(PF3,t));
  288.  
  289.           IF oz >  11 THEN z :=  11;
  290.           IF oz < -36 THEN z := -36;
  291.  
  292.           ot := ROUND(t);
  293.  
  294.           FOR i := 0 TO NFrames-1 DO BEGIN
  295.              t := i*(PF1.pts[PF1.npts-1].t - PF1.pts[2].t)/NFrames +
  296.                   PF1.pts[2].t;
  297.              x := Interpolate(PF1,t);
  298.              y := Interpolate(PF2,t);
  299.              z := Interpolate(PF3,t);
  300.  
  301.              IF z >  11.0 THEN z :=  11.0;
  302.              IF z < -36.0 THEN z := -36.0;
  303.  
  304.              b :=  (ROUND(x) - ox) AND $FF;
  305.              Write(f, b);
  306.              b :=  (ROUND(y) - oy) AND $FF;
  307.              Write(f, b);
  308.              b :=  (ROUND(z) - oz) AND $FF;
  309.              Write(f, b);
  310.  
  311.              ox := ROUND(x);
  312.              oy := ROUND(y);
  313.              oz := ROUND(z);
  314.  
  315.           END;
  316.  
  317.           Close(f);
  318.  
  319.         END;
  320.  
  321.    END;
  322.  
  323.  
  324. VAR
  325.   mx, my,
  326.   mt, mz : INTEGER;
  327.   b      : BYTE;
  328.   l      : LONGINT;
  329.   d      : WORD;
  330.  
  331.  
  332. PROCEDURE RePinta;
  333.   BEGIN
  334.  
  335.          ASM
  336.                 MOV     AX,2
  337.                 INT     33h
  338.          END;
  339.  
  340.          NFrames := mt DIV 4;
  341.  
  342.          Pinta;
  343.  
  344.          ASM
  345.                 MOV     AX,1
  346.                 INT     33h
  347.          END;
  348.   END;
  349.  
  350.  
  351. PROCEDURE EscribeZ;
  352.   BEGIN
  353.     FillChar(Screen[200-8, 0], 320*8, 12);
  354.     GotoXY(1, 25);
  355.     DirectVideo := FALSE;
  356.     Write(mz : 6 );
  357.   END;
  358.  
  359.  
  360. VAR
  361.   St : TDosStream;
  362. LABEL
  363.   Fin;
  364. BEGIN
  365.  
  366.   NEW(Pant);
  367.  
  368.   St.Init('..\..\graf\monoigua.pix', stOpenRead);
  369.   St.Read(Pant^, 64000);
  370.   St.Done;
  371.  
  372.  
  373.   ASM
  374.      MOV       AX,13h
  375.      INT       10h
  376.      XOR       AX,AX
  377.      INT       33h
  378.      MOV       AX,1
  379.      INT       33h
  380.   END;
  381.  
  382.   DumpPal;
  383.  
  384.   mz := -36;
  385.   PF1.npts := 0;
  386.   PF2.npts := 0;
  387.   PF3.npts := 0;
  388.   t        := 100;
  389.  
  390.   REPEAT
  391.  
  392.      IF KeyPressed THEN
  393.        BEGIN
  394.          CASE ReadKey OF
  395.            #0  : ReadKey;
  396.            's',
  397.            'S' : BEGIN
  398.                    WritePtList('ptlist.txt');
  399.                  END;
  400.            'l',
  401.            'L' : BEGIN
  402.                    ReadPtList('ptlist.txt');
  403.                    mt := ROUND(PF1.pts[PF1.npts].t);
  404.                    RePinta;
  405.                  END;
  406.            '+' : BEGIN
  407.                    INC(mz);
  408.                    EscribeZ;
  409.                  END;
  410.            '-' : BEGIN
  411.                    DEC(mz);
  412.                    EscribeZ;
  413.                  END;
  414.            #27 : GOTO Fin;
  415.          END;
  416.        END;
  417.  
  418.      ASM
  419.                 MOV     AX,3
  420.                 INT     33h
  421.                 SHR     CX,1
  422.                 MOV     [mx],CX
  423.                 MOV     [my],DX
  424.                 MOV     [b],BL
  425.      END;
  426.  
  427.      IF (b AND 1) <> 0 THEN
  428.        BEGIN
  429.  
  430.          WHILE (b AND 1) <> 0 DO
  431.            ASM
  432.                 MOV     AX,3
  433.                 INT     33h
  434.                 SHR     CX,1
  435.                 MOV     [mx],CX
  436.                 MOV     [my],DX
  437.                 MOV     [b],BL
  438.            END;
  439.  
  440.  
  441.          INC(mt, 100);
  442.  
  443.          INC(PF1.npts);
  444.          INC(PF2.npts);
  445.          INC(PF3.npts);
  446.  
  447.          PF1.pts[PF1.npts].t := mt;
  448.          PF2.pts[PF2.npts].t := mt;
  449.          PF3.pts[PF3.npts].t := mt;
  450.  
  451.          PF1.pts[PF1.npts].f := mx;
  452.          PF2.pts[PF2.npts].f := my;
  453.          PF3.pts[PF3.npts].f := mz;
  454.  
  455.          RePinta;
  456.  
  457.        END;
  458.  
  459.      IF (b AND 2) <> 0 THEN
  460.        BEGIN
  461.  
  462.          l := $7FFFFFFF;
  463.          d := 1;
  464.  
  465.          FOR i := 1 TO PF1.npts DO
  466.            IF l > ROUND ((mx-PF1.pts[i].f)*(mx-PF1.pts[i].f) +
  467.                          (my-PF2.pts[i].f)*(my-PF2.pts[i].f)) THEN
  468.              BEGIN
  469.                l := ROUND((mx-PF1.pts[i].f)*(mx-PF1.pts[i].f) +
  470.                           (my-PF2.pts[i].f)*(my-PF2.pts[i].f));
  471.                d := i;
  472.              END;
  473.  
  474.          WHILE (b AND 2) <> 0 DO
  475.            ASM
  476.                 MOV     AX,3
  477.                 INT     33h
  478.                 SHR     CX,1
  479.                 MOV     [mx],CX
  480.                 MOV     [my],DX
  481.                 MOV     [b],BL
  482.            END;
  483.  
  484.          PF1.pts[d].f := mx;
  485.          PF2.pts[d].f := my;
  486.          PF3.pts[d].f := mz;
  487.  
  488.          RePinta;
  489.  
  490.        END;
  491.  
  492.   UNTIL FALSE;
  493.  
  494. Fin:
  495.  
  496.  
  497.  
  498.   ASM
  499.      MOV       AX,3
  500.      INT       10h
  501.   END;
  502.  
  503.  
  504.   Salva;
  505.  
  506.  
  507. END.
  508.